home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / lang / amigatalk.lha / intuition / BitMap.st next >
Text File  |  2002-01-16  |  4KB  |  163 lines
  1. "---------------------------------------------------------------"
  2. " BitMap Class implements control of Amiga BitMaps.             "
  3. " ------------------------------------------------------------- "
  4. " See BitMapFlags class after this class for valid values for   "
  5. " Flags "
  6.  
  7. " Test file:
  8.   bmap   <- BitMap      new
  9.   bflags <- BitMapFlags new
  10.  
  11.   flags <-         bflags bitMapFlag: #BMF_DISPLAYABLE
  12.   flags <- flags + bflags bitMapFlag: #BMF_INTERLEAVED
  13.   flags <- flags + bflags bitMapFlag: #BMF_STANDARD
  14.               
  15.   bmap setBitMapWidth:  540
  16.   bmap setBitMapHeight: 90
  17.   bmap setBitMapDepth:  8
  18.   bmap setBitMapFlags:  flags
  19.   bmap makeBitMap
  20.   ...
  21.   bmap dispose
  22. "
  23. " More methods to obtain data from the system have to be added, "
  24. " such as reading IFF files & transforming them into something  "
  25. " that this class can use to write it's own custom files.       "
  26. "---------------------------------------------------------------"
  27.  
  28. Class BitMap :Glyph  ! private width height depth flags !
  29. [
  30.    dispose
  31.       <primitive 189 0 private>
  32. |
  33.    getBitMapWidth
  34.       ^ width <- <primitive 189 2 0 private>
  35. |
  36.    getBitMapHeight
  37.       ^ height <- <primitive 189 2 1 private>
  38. |
  39.    getBitMapFlags
  40.       ^ flags <- <primitive 189 2 2 private>
  41. |
  42.    getBitMapDepth
  43.       ^ depth <- <primitive 189 2 3 private>
  44. |
  45.    changeBitMapWidth: newWidth
  46.       <primitive 189 3 0 newWidth private>.
  47.       width <- newWidth
  48. |
  49.    changeBitMapHeight: newHeight
  50.       <primitive 189 3 1 newHeight private>.
  51.       height <- newHeight
  52. |
  53.    changeBitMapFlags: newFlags
  54.       <primitive 189 3 2 newFlags private>.
  55.       flags <- newFlags
  56. |
  57.    changeBitMapDepth: newDepth
  58.       <primitive 189 3 3 newDepth private>.
  59.       depth <- newDepth
  60. |
  61.    changeDataTo: longWord at: offset
  62.       ^ <primitive 189 10 longWord offset private>
  63. |
  64.    readBitMapFile: bitMapFileName
  65.       (<primitive 189 4 bitMapFileName private> == false)
  66.          ifTrue: [ ^ nil ].
  67.  
  68.       width  <- <primitive 189 2 0 private>.
  69.       height <- <primitive 189 2 1 private>.
  70.       flags  <- <primitive 189 2 2 private>.
  71.       depth  <- <primitive 189 2 3 private>.
  72.  
  73.       ^ self
  74. |
  75.    writeBitMapFile: bitMapFileName
  76.       <primitive 189 5 bitMapFileName private>
  77. |
  78.    setBitMapWidth: newWidth
  79.       width <- newWidth
  80. |
  81.    setBitMapHeight: newHeight
  82.       height <- newHeight
  83.  
  84. |
  85.    setBitMapFlags: newFlags
  86.       flags <- newFlags
  87. |
  88.    setBitMapDepth: newDepth
  89.       depth <- newDepth
  90. |
  91.    makeBitMap
  92.       private <- <primitive 189 1 width height depth flags>.
  93.       ^ self
  94. |
  95.    getBitMapObject
  96.       ^ private
  97. |
  98.    stealBitMapFromWindow: windowObj
  99.       private <- <primitive 189 6 windowObj>.
  100.       ^ private
  101. |
  102.    stealBitMapFromScreen: screenObj
  103.       private <- <primitive 189 7 screenObj>.
  104.       ^ private
  105. |
  106.    stealBitMapFromWindowTitled: windowTitle
  107.       private <- <primitive 189 8 windowTitle>.
  108.       ^ private
  109. |
  110.    stealBitMapFromScreenTitled: screenTitle
  111.       private <- <primitive 189 9 screenTitle>.
  112.       ^ private
  113. ]
  114.  
  115. " ------------------------------------------------------------------- "
  116. " BitMapFlags Class is a Singleton class that allows the user to      "
  117. " reference BitMap Flags' hexadecimal values.                         "
  118. ""
  119. " ALL singleton classes MUST contain the following:                   "
  120. ""
  121. "   the methods:  isSingleton AND privateSetup     AND                "
  122. "                 uniqueInstance Class instance variable.             "
  123. " ------------------------------------------------------------------- "
  124.  
  125. Class BitMapFlags :Dictionary ! uniqueInstance !
  126. [
  127.    isSingleton
  128.      ^ true  
  129. |
  130.    bitMapFlag: keySymbol
  131.      ^ (self at: keySymbol)  
  132. |
  133.    privateNew ! newinstance !
  134.      newinstance <- super new.
  135.  
  136.      ^ newinstance
  137. |
  138.    new
  139.      ^ self privateSetup
  140. |
  141.    privateSetup
  142.      (uniqueInstance isNil)
  143.        ifTrue: [uniqueInstance <- self privateNew.
  144.  
  145.                 " flags for AllocBitMap, etc. "
  146.  
  147.                 self at: #BMF_CLEAR       put: 1.
  148.                 self at: #BMF_DISPLAYABLE put: 2.
  149.                 self at: #BMF_INTERLEAVED put: 4.
  150.                 self at: #BMF_STANDARD    put: 8.
  151.                 self at: #BMF_MINPLANES   put: 16.
  152.  
  153.                 " the following are for GetBitMapAttr() "
  154.  
  155.                 self at: #BMA_HEIGHT      put: 0.
  156.                 self at: #BMA_DEPTH       put: 4.
  157.                 self at: #BMA_WIDTH       put: 8.
  158.                 self at: #BMA_FLAGS       put: 12.
  159.                ].
  160.                
  161.      ^ self    "or ^ uniqueInstance??"
  162. ]
  163.